home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1994 November: Tool Chest / Dev.CD Nov 94.toast / Sample Code / Snippets / Toolbox / MDEF.Sample / pMyMDEF.p < prev    next >
Encoding:
Text File  |  1992-07-15  |  9.2 KB  |  422 lines  |  [TEXT/MPS ]
  1. {$R-}
  2. UNIT MDEFunit;
  3.  
  4. INTERFACE
  5.  
  6. USES Memtypes, Quickdraw, OSIntf, ToolIntf,PackIntf;
  7.  
  8. procedure MyMenu (message: integer; theMenu: MenuHandle; var MenuRect: rect; hitPt: point; var whichitem: integer);
  9.  
  10. IMPLEMENTATION
  11.  
  12. CONST
  13.         normaltext =    0;
  14.         boldtext =        1;
  15.         italictext =    2;
  16.         underlinetext =    4;
  17.         outlinetext = 8;
  18.         shadowtext = 16;
  19.         condensetext = 32;
  20.         extendtext = 64;
  21.      
  22.         mygray = 'AA55AA55AA55AA55';
  23.         FIRST_5_FIELDS = 14;
  24.         FOUR_BYTES = 4;
  25.         INSET_VALUE = 12;
  26.         TEXT_FACE_OFFSET = 3;
  27.         itemheight = 16;
  28.  
  29.  
  30. PROCEDURE DrawItem(item: Integer; ItemRect: Rect; theMenu: MenuHandle); FORWARD;
  31.  
  32. PROCEDURE DrawMenu(theMenu: MenuHandle; MenuRect: Rect); FORWARD;
  33.  
  34. PROCEDURE SizeMenu(theMenu: MenuHandle); FORWARD;
  35.  
  36.  
  37. function ItemRect (item: integer; MenuRect: Rect): rect; FORWARD;
  38.  
  39. procedure MyMenu (message: integer; theMenu: MenuHandle; var MenuRect: rect; 
  40.                     hitPt: point; var whichitem: integer);
  41.     const
  42.         itemheight = 16;
  43.     type
  44.         TwoIntsMakeAlong = RECORD
  45.             CASE INTEGER OF
  46.                 0: (Hi: INTEGER;
  47.                     Low: INTEGER);
  48.                 1: (HiAndLow: Longint);
  49.             END;
  50.             
  51.         mbsavelocRec = RECORD
  52.                 Mystery: PACKED ARRAY[0..5] OF Byte;
  53.                 saveRect: Rect;
  54.                 unknownWord: Integer;
  55.                 FlagWord: Integer;
  56.         END;
  57.         mbsavelocPtr = ^mbsavelocRec;
  58.         mbsavelocHandle = ^mbsavelocPtr;
  59.     var
  60.         y: integer;
  61.         temp: integer;
  62.         box: rect;
  63.         MenuChoicePtr: ^longint;
  64.         AtMenuBotPtr:    ^integer;
  65.         mbsaveholder: ^mbsavelocHandle;
  66.         oldwhichitem: integer;
  67.         mbsavehdl: mbsavelocHandle;
  68.         s: Str255;
  69.         TheChoice: TwoIntsMakeAlong;
  70.         temprect: Rect;
  71.         
  72.         t:    MenuHandle;
  73.         
  74. procedure InvertItem (item: integer; leaveblack: Boolean);
  75.     VAR
  76.         r: Rect;
  77.         rhdl: RgnHandle;
  78.     begin
  79.         rhdl := NewRgn();
  80.         GetClip(rhdl);
  81.         r := ItemRect(item,MenuRect);
  82.         EraseRect(r);
  83.         ClipRect(r);
  84.         DrawItem(item,r,theMenu);
  85.         SetClip(rhdl);
  86.         DisposeRgn(rhdl);
  87.         IF leaveblack THEN
  88.             InvertRect(r);
  89.     end;
  90.  
  91.         
  92.     
  93. begin
  94.     case message of
  95.         mDrawMsg: 
  96.             DrawMenu(theMenu, MenuRect);
  97.             
  98.         mChooseMsg: 
  99.             begin
  100.                 oldwhichitem := whichitem;
  101.                 whichitem := 0;
  102.                 MenuChoicePtr := pointer($B54);
  103.  
  104.                 if PtInRect(hitPt, MenuRect) then
  105.                     begin
  106.                     
  107.                         y := ((hitpt.v - MenuRect.top) div itemheight) + 1;
  108.                         
  109.                         {get item rect}
  110.                         temprect := itemrect(y,MenuRect);
  111.                         mbsaveholder := pointer($B5C);
  112.                         mbsavehdl := mbsaveholder^;
  113.                         
  114.                         {store it in mbSaveLoc}
  115.                         temp := themenu^^.menuid;
  116.                         TheChoice.hi := themenu^^.menuid;
  117.                         TheChoice.low := y;
  118.                         MenuChoicePtr^ := TheChoice.HiAndLow;
  119.                         
  120.                         whichItem := y;
  121.                         {}
  122.                         
  123.                         if whichitem <> oldwhichitem then
  124.                             
  125.                             begin
  126.                                 IF ( BTST(theMenu^^.enableFlags,whichitem)) THEN BEGIN
  127.                                     InvertItem(WhichItem,TRUE);
  128.                                     InvertItem({y}oldwhichitem,FALSE);
  129.                                 END
  130.                                 ELSE BEGIN
  131.                                     InvertItem(oldwhichitem,FALSE);
  132.                                     whichItem := 0;
  133.                                 END;
  134.                             end;
  135.                         mbsavehdl^^.saveRect := TempRect;
  136.                         mbsavehdl^^.FlagWord := 1;
  137.                         
  138.                     end
  139.                 else
  140.                     begin
  141.                         InvertItem(oldWhichItem,FALSE);
  142.                         TheChoice.hi := theMenu^^.menuID;
  143.                         TheChoice.low := 0;
  144.                         MenuChoicePtr^ := TheChoice.HiAndLow;
  145.                     end;
  146.             end;
  147.         mSizeMsg: 
  148.             SizeMenu(theMenu);
  149.         otherwise
  150.             sysbeep(10);
  151.     end;
  152. end;
  153.  
  154. function ItemRect (item: integer; MenuRect: Rect): rect;
  155.     VAR
  156.         box: Rect;
  157.     begin
  158.         if item > 0 then
  159.             begin
  160.                 box := MenuRect;
  161.                 box.top := box.top + (item - 1) * itemheight;
  162.                 box.bottom := box.top + itemheight;
  163.             end
  164.         else
  165.             SetRect(box, 0, 0, 0, 0);
  166.         ItemRect := box;
  167.     end;
  168.     
  169.  
  170.  
  171.  
  172.  
  173. PROCEDURE GetStyle(stylenumber: SignedByte; VAR theStyle: Style);
  174. VAR
  175.     selector: Integer;
  176. BEGIN
  177.     CASE stylenumber OF
  178.         normaltext:    
  179.             theStyle := [];
  180.         boldtext: 
  181.             theStyle := [bold];
  182.         italictext:  
  183.             theStyle := [italic];
  184.         underlinetext: 
  185.             theStyle := [underline];
  186.         outlinetext:    
  187.             theStyle := [outline];    
  188.         shadowtext: 
  189.             theStyle := [shadow];
  190.         condensetext:
  191.             theStyle := [condense];
  192.         extendtext:
  193.             theStyle := [extend];
  194.         otherwise
  195.             theStyle := [];
  196.     END;
  197. END;
  198.  
  199.  
  200. PROCEDURE DrawItem(item: Integer; ItemRect: Rect; theMenu: MenuHandle);
  201.     
  202. VAR
  203.     hierIconRect:     Rect;
  204.     shiftIconRect:     Rect;
  205.     SICNHdl:        Handle;
  206.     fontmetrics:     FontInfo;
  207.     graypat:        Pattern;
  208.     titlelenght:     Integer;
  209.     thestyle:        Style;
  210.     gp:                GrafPtr;
  211.     I:                 Integer;
  212.     bm:                BitMap;
  213.     titleLength:    Integer;
  214.     dataPtr:        Ptr;
  215.     tempptr:        Ptr;
  216.     
  217. BEGIN
  218.     {make a gray}
  219.     StuffHex(@graypat,mygray);
  220.     {set the rects for our special icons}
  221.     hierIconRect := ItemRect;
  222.     hierIconRect.left := hierIconRect.right - 16;
  223.     
  224.     shiftIconRect.top := ItemRect.top;
  225.     shiftIconRect.bottom := ItemRect.bottom;
  226.     shiftIconRect.right := hierIconRect.left - 3;
  227.     shiftIconRect.left := shiftIconRect.right - 16;
  228.     
  229.     {now get our 2 SICN's}
  230.     SICNHdl := GetResource('SICN',128);  {no checking now we will check whenever we use it}
  231.     
  232.     IF SICNHdl <> NIL THEN BEGIN {we got it make it a bitmap}
  233.         HNoPurge(SICNHdl);
  234.         SetRect(bm.bounds,0,0,16,16);
  235.         bm.rowBytes := 2;
  236.     END;
  237.     
  238.     
  239.     {how long is the title}
  240.     WITH theMenu^^ DO
  241.     titlelength := ORD(menuData[0]) + 1;
  242.     
  243.     {point past it}
  244.     HLock(Handle(theMenu));
  245.     
  246.     {here is where pascal gets to be a pain, C too for that matter}
  247.     WITH theMenu^^ DO
  248.     dataPtr := POINTER(ORD4(@menudata) + titlelength);
  249.     
  250.     FOR I := 1 TO item-1 DO  {get to the item's data}
  251.         dataPtr := POINTER(ORD4(dataPtr) + dataPtr^ + FOUR_BYTES + 1);
  252.         
  253.     {now we are pointing at the data for the item we care about}
  254.     IF StringPtr(dataptr)^ = '-' THEN BEGIN
  255.         PenPat(graypat);
  256.         MoveTo(ItemRect.left,ItemRect.top + 8);
  257.         LineTo(ItemRect.right,ItemRect.top + 8);
  258.         PenNormal;
  259.     END
  260.     ELSE BEGIN
  261.         {what is the typeface}
  262.         tempptr := POINTER(ORD4(dataptr) + dataPtr^ + 1 + TEXT_FACE_OFFSET);
  263.         GetStyle(tempptr^,thestyle);
  264.         TextFace(thestyle);
  265.         GetFontInfo(FontMetrics);
  266.         MoveTo(ItemRect.left + INSET_VALUE,ItemRect.bottom - FontMetrics.descent);
  267.         DrawString(StringPtr(dataPtr)^);
  268.         TextFace([]);
  269.         
  270.         {look at the icon bit, we don't support real icons (its too hard to figure item height)}
  271.         {anyway they look stupid in menus}
  272.         tempptr := POINTER(ORD4(dataptr) + dataPtr^ + 1);
  273.         IF tempptr^ = 1 THEN {it is  a shift command item so draw the shift icon}
  274.             IF SICNHdl <> NIL THEN BEGIN
  275.             
  276.                 GetPort(gp);
  277.                 HLock(SICNHdl);
  278.                 bm.baseAddr := SICNHdl^;
  279.                 CopyBits(bm,gp^.portBits,bm.bounds,shiftIconRect,srcCopy,nil);
  280.                 HUnlock(SICNHdl);
  281.             END;
  282.         
  283.         {check command key}
  284.         tempptr := POINTER(ORD4(tempptr) + 1);
  285.         IF tempptr^ > $1F THEN BEGIN  {draw the character}
  286.             MoveTo(ItemRect.right - 24,ItemRect.bottom - FontMetrics.descent);
  287.             DrawChar(CHR(17));
  288.             DrawChar(CharsPtr(tempptr)^[0]);
  289.         END
  290.         ELSE
  291.         IF tempptr^ = $1B THEN {we have a submenu so draw the indicator}
  292.             IF SICNHdl <> NIL THEN BEGIN
  293.             
  294.                 GetPort(gp);
  295.                 HLock(SICNHdl);
  296.                 bm.baseAddr := POINTER(ORD4(SICNHdl^) + 32);
  297.                 CopyBits(bm,gp^.portBits,bm.bounds,hierIconRect,srcCopy,nil);
  298.                 HUnlock(SICNHdl);
  299.             END;
  300.             
  301.         {finally if it is disabled }
  302.         IF (NOT BTST(theMenu^^.enableFlags,item)) THEN BEGIN
  303.             PenPat(graypat);
  304.             PenMode(patBic);
  305.             ItemRect.right := ItemRect.right - 2;
  306.             ItemRect.left := ItemRect.left + 4;
  307.             PaintRect(ItemRect);
  308.             PenNormal;
  309.         END;
  310.         
  311.         IF SICNHdl <> NIL THEN
  312.             HPurge(SICNHdl);
  313.         HUnlock(Handle(theMenu));
  314.     END;  {of drawing code}
  315. END;
  316.  
  317. PROCEDURE SizeMenu(theMenu: MenuHandle);
  318. CONST
  319.     ITEMHEIGHT = 16;
  320.     HierIconWidth = 16;
  321.     Slop = 18;
  322.     shiftIconWidth = 19;
  323. TYPE
  324.     FourBytes = PACKED ARRAY[0..3] OF SignedByte;
  325.     FourBytePtr = ^FourBytes;
  326. VAR
  327.     maxWidth: Integer;
  328.     dataPtr:    Ptr;
  329.     numItems:    Integer;
  330.     tempwidth:  Integer;
  331.     AddSlop:    Boolean;
  332.     I: Integer;
  333.     
  334. BEGIN
  335.  
  336.     {we use stringwidth so lock the menuhandle}
  337.     HLock(Handle(theMenu));
  338.     
  339.     WITH theMenu^^ DO
  340.         dataPtr := @menudata;
  341.     
  342.     {move past the title}
  343.     dataPtr := POINTER(ORD4(dataPtr)+dataPtr^+1);
  344.     
  345.     numItems := CountMItems(theMenu);
  346.     theMenu^^.menuHeight := numItems * ItemHeight;  {gross, but simple}
  347.     
  348.     {now figure out the width}
  349.     maxWidth := INSET_VALUE;
  350.     AddSlop := FALSE;
  351.     FOR I := 1 TO numItems DO BEGIN
  352.     
  353.         IF dataPtr^ <> ORD('-') THEN BEGIN  {the lines are as long as the longest item}
  354.             TextFont(0);
  355.             tempwidth := StringWidth(StringPtr(dataPtr)^) + 4;
  356.             
  357.             {increment dataPtr to point at do-dads}
  358.             dataPtr := POINTER(ORD4(dataPtr)+dataPtr^+1); {first at icon byte}
  359.             
  360.             IF FourBytePtr(dataPtr)^[0] = 1 THEN BEGIN  {uses shift icon}
  361.                 tempwidth := tempwidth + shiftIconWidth ;
  362.                 AddSlop := TRUE;
  363.             END;
  364.             
  365.             {dataPtr := POINTER(ORD4(dataPtr)+1);} {now at command byte}
  366.             IF FourBytePtr(dataPtr)^[1] > $1F THEN BEGIN
  367.                 tempwidth := tempwidth + CharWidth(CHR(17)) + CharWidth(CharsPtr(dataPtr)^[1]); 
  368.                              { CharWidth(CHR(dataPtr^));}
  369.                 AddSlop := TRUE;
  370.             END
  371.             ELSE
  372.             IF FourBytePtr(dataPtr)^[1]  = $1B THEN BEGIN
  373.                 tempwidth := tempwidth + HierIconWidth;
  374.                 AddSlop := TRUE;
  375.             END;
  376.             
  377.             {don't feel like supporting Marks either.  I'll leave it as an exercise}
  378.             
  379.             IF AddSlop THEN
  380.                 tempwidth := tempwidth + Slop;
  381.                 
  382.             IF tempwidth > maxWidth THEN
  383.                 maxWidth := tempwidth;
  384.                 
  385.             {add four to data ptr so we point at start of next string}
  386.             dataPtr := POINTER(ORD4(dataPtr)+4);
  387.         END;
  388.         
  389.         theMenu^^.menuWidth := maxWidth;
  390.     END;
  391.     HUnlock(Handle(theMenu));
  392. END;
  393.             
  394.             
  395.  
  396.             
  397.                 
  398.     
  399.     
  400.     
  401.     
  402.  
  403. PROCEDURE DrawMenu(theMenu: MenuHandle; MenuRect: Rect);
  404. VAR
  405.     numItems: Integer;
  406.     I : Integer;
  407.     theRect: Rect;
  408.  
  409. BEGIN
  410.     
  411.     numItems := CountMItems(theMenu);
  412.     
  413.     FOR I := 1 TO numItems DO BEGIN
  414.         theRect := ItemRect(I,MenuRect);
  415.         DrawItem(I,theRect,theMenu);
  416.     END;
  417.     
  418. END;
  419.     
  420. END.
  421.  
  422.